home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip / Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf / GFA.Anwendung / ICONTYP.LST < prev    next >
File List  |  1992-09-14  |  5KB  |  133 lines
  1. REM  *********************************
  2. REM  * Icontyp 1.00                  *
  3. REM  * © 26.4.1992 by Henry König    *
  4. REM  * Bornheide 71, 2000 Hamburg 53 *
  5. REM  *********************************
  6. init                            ! Bildschirm und Fenster öffnen
  7. icon.wechseln                   ! Hauptprozedur
  8. CLOSES 1                        ! Bildschirm schließen
  9. CLOSEW #1                       ! Fenster schließen
  10. END                             ! und zurück zur WB
  11. PROCEDURE icon.wechseln         ! die Hauptprozedur
  12.   y$="j"                        ! Eingangswert für die Schleife
  13.   WHILE y$="j"                  !
  14.     programmkopf
  15.     PRINT AT(14,28);"© 1992 by Henry König, Bornheide 71, 2000 Hamburg 53."
  16.     PRINT AT(24,31);"Icons (Piktogramme) enden mit '.info'."
  17.     programmauswahl("Icon wählen","OK",pfad$,dateiname$)
  18.     IF abbruch%=0 THEN
  19.       programmkopf
  20.       PRINT AT(2,5);"Icontypen:     Icon-Name: ";dateiname$
  21.       PRINT AT(2,6);"----------     aktueller Icontyp wird gelb markiert."
  22.       PRINT AT(2,10);"1 - Disketten"
  23.       PRINT AT(2,12);"2 - Drawer (Schubladen)"
  24.       PRINT AT(2,14);"3 - Tool (Programme)"
  25.       PRINT AT(2,16);"4 - Projekt (Texte und Scriptdateien)"
  26.       PRINT AT(2,18);"5 - Garbage (Mülleimer)"
  27.       OPEN "R",#1,pfad$+dateiname$,1  ! Icon als rel. Datei öffnen
  28.       FIELD #1,1 AS icon$
  29.       GET #1,49                 ! Icontyp lesen
  30.       it%=ASC(icon$)
  31.       PCOLOR 5,0                ! gelb
  32.       SELECT it%
  33.       CASE 1
  34.         PRINT AT(2,10);"1 - Disketten"
  35.       CASE 2
  36.         PRINT AT(2,12);"2 - Drawer (Schubladen)"
  37.       CASE 3
  38.         PRINT AT(2,14);"3 - Tool (Programme)"
  39.       CASE 4
  40.         PRINT AT(2,16);"4 - Projekt (Texte und Scriptdateien)"
  41.       CASE 5
  42.         PRINT AT(2,18);"5 - Garbage (Mülleimer)"
  43.       ENDSELECT
  44.       PCOLOR 1,0
  45.       PRINT AT(2,20);"0 - Abruch"
  46.       PRINT AT(2,22);"Ihre Wahl --> ";
  47.       INPUT x$                  ! Typ abfragen
  48.       x%=VAL(x$)                ! Typ nach Ziffern wandeln
  49.       IF x%<1 OR x%>5 THEN      ! ungültiger Typ
  50.         abbruch%=1              ! dann Abbruchflag setzen
  51.       ELSE
  52.         LSET icon$=CHR$(x%)     ! neue Kennung schreiben
  53.         PUT #1,49               ! Icontyp schreiben
  54.       ENDIF
  55.       CLOSE #1                  ! Datei (Icon) wieder schließen
  56.     ENDIF
  57.     programmfuss                ! letzte Anweisung ausblenden
  58.     PRINT AT(4,28);"Noch ein Icontyp ändern (j/n): ";
  59.     INPUT y$                    !
  60.   WEND
  61. RETURN
  62. PROCEDURE programmkopf          ! Bildschirm löschen u. Programmnamen ausgeben
  63.   CLS
  64.   COLOR 2                       ! schwarze Box
  65.   PBOX 1,1,639,20
  66.   COLOR 0                       ! grau
  67.   PBOX 6,4,633,17
  68.   COLOR 4                       ! hellgrau
  69.   LINE 6,4,633,4
  70.   LINE 6,4,6,17
  71.   PRINT AT(2,2);SPACE$(78)
  72.   PCOLOR 5,0
  73.   PRINT AT(25,2);"Ändern der Icontypen (Piktogramme)"
  74.   PCOLOR 1,0
  75.   programmfuss
  76. RETURN
  77. PROCEDURE programmfuss          ! Anweisungsboxen zeichnen
  78.   COLOR 2                       ! schwarz
  79.   PBOX 1,(27*8)-10,639,(32*8)   ! schwarze Box
  80.   COLOR 0                       ! grau
  81.   PBOX 6,(27*8)-7,633,(28*8)+4  ! graue Box
  82.   PBOX 6,(29*8)+2,633,(32*8)-4  ! 2. graue Box
  83.   COLOR 4                       ! hellgrau
  84.   BOX 7,(27*8)-7,633,(32*8)-3
  85.   LINE 7,(29*8)+2,633,(29*8)+2
  86.   LINE 16,(29*8)-6,639-16,(29*8)-6
  87.   LINE 16,(29*8)+5,639-16,(29*8)+5
  88.   LINE 639-16,(29*8)-6,639-16,(26*8)+4  ! senkrechter Strich
  89.   LINE 16,(29*8)+5,16,(31*8)+2  ! senkrechter Strich
  90.   COLOR 2                       ! schwarz
  91.   LINE 7,(32*8)-3,633,(32*8)-3  ! schwarze Linie
  92.   LINE 633,(27*8)-7,633,(32*8)-3
  93.   LINE 16,(27*8)-4,639-16,(27*8)-4
  94.   LINE 16,(31*8)+2,639-16,(31*8)+2
  95.   LINE 16,(29*8)-6,16,(26*8)+4  ! senkrechter Strich
  96.   LINE 639-16,(29*8)+5,639-16,(31*8)+2    ! senkrechter Strich
  97. RETURN
  98. PROCEDURE init                  ! Bildschirm öffnen
  99.   breite%=640                   ! Screenbreite
  100.   hoehe%=256                    ! Screenhöhe
  101.   ebenen%=3                     ! 3 Bitplanes
  102.   OPENS 1,0,0,breite%,hoehe%,ebenen%,&H8000
  103.   OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
  104.   farben.setzen                 ! Farbpalette setzen
  105. RETURN
  106. PROCEDURE farben.setzen         ! Farben für Bildschirm
  107.   SETCOLOR 0,5,5,5              ! grau statt blau
  108.   SETCOLOR 1,15,15,15           ! weiß bleibt
  109.   SETCOLOR 2,0,0,0              ! schwarz erhalten
  110.   SETCOLOR 3,15,5,0             ! rot bleibt
  111.   SETCOLOR 4,10,10,10           ! hellgrau inverse Farbe im Filerequester
  112.   SETCOLOR 5,15,15,0            ! gelb
  113.   SETCOLOR 6,0,0,0              ! schwarz = Inverse Farbe im Filerequester
  114. RETURN
  115. PROCEDURE programmauswahl(titel$,oktext$,VAR pfad$,dateiname$)
  116.   CLR abbruch%                  ! Abbruchflag löschen
  117.   FILESELECT titel$,oktext$,pfad$,dateiname$
  118.   pos1%=RINSTR(dateiname$,"/")
  119.   pos2%=RINSTR(dateiname$,":")
  120.   IF pos1%>0 THEN               ! Dateipfad herausfiltern
  121.     pfad$=MID$(dateiname$,1,pos1%)
  122.     dateiname$=MID$(dateiname$,pos1%+1)
  123.   ELSE IF pos2%>1 AND pos1%=0   ! Laufwerk nach Drive$()
  124.     pfad$=LEFT$(dateiname$,pos2%)
  125.     dateiname$=MID$(dateiname$,pos2%+1)
  126.   ENDIF
  127.   IF dateiname$="" OR RIGHT$(dateiname$,5)<>".info" THEN
  128.     abbruch%=1                  ! Abbruchflag setzen
  129.   ENDIF
  130. RETURN
  131. REM                               ! damit beim Kopieren der Interpreter nicht
  132. REM                               ! abstürzt
  133.